--
-- $Id: xpa-list-single.adb,v 1.4 2005-08-03 15:41:36 bacon Exp $
--

with ada.unchecked_deallocation;

package body xpa.list.single is

	procedure free_node is new ada.unchecked_deallocation (node, node_access);

	procedure finalize (object: in out list)
	begin
		clear (object);	
	end finalize;

	function size (object: in list) return natural is
	begin
		return object.size;
	end size;

	procedure clear (object: in out list) is
		x, y: node_access;
	begin
		x := object.head;
		while x /= null loop
			y := x.next;		
			free_node (x);
			x := y;
		end loop;
		
		object.size := 0;
		object.head := null;
		object.tail := null;
	end clear;

	procedure prepend (object: in out list; datum: in datum_type) is
		x: node_access;
	begin
		x := new node'(datum => datum, next => null);
		if object.head = null then
			object.head := x;
			object.tail := x;
		else
			x.next := object.head;
			object.head := x;
		end if;

		object.size := object.size + 1;
	end prepend;

	procedure append (object: in out list; datum: in datum_type) is
		x: node_access;
	begin
		x := new node'(datum => datum, next => null);
		if object.head = null then
			object.head := x;
			object.tail := x;
		else
			object.tail.next := x;
			object.tail := x;
		end if;

		object.size := object.size + 1;
	end append;

	function first (object: in list) return node_access is
	begin
		return object.head;
	end first;

	function last (object: in list) return node_access is
	begin
		return object.tail;
	end last;

	function is_valid (node_pointer: in node_access) return boolean is
	begin
		return node_pointer /= null;
	end is_valid;

	function forward (node_pointer: in node_access) return node_access is
	begin
		return node_pointer.next;
	end forward;

	function value (node_pointer: in node_access) return datum_type is
	begin
		return node_pointer.datum;
	end value;

end xpa.list.single;
